#lang racket


(require mysterx)


(provide load-autocad-com
         
         ; methods
         add-arc
         add-circle
         add-ellipse
         add-line
         add-polyline
         add-spline
         add-box
         add-cone
         add-cylinder
         add-sphere
         add-extruded-solid
         add-region
         boolean
         delete
         end-undo-mark
         get-bounding-box
         item
         move
         offset
         rotate3d
         start-undo-mark
         transform-by
         
         ; properties
         position
         get-handle
         get-modelspace-count
         get-object-name
         
         ; arc properties
         arc?
         get-arc-center
         get-arc-radius
         get-arc-start-angle
         get-arc-end-angle
         
         ; commands
         vbCr
         send-command)


(define (try-connection fn (count 1))
  (define (try-connection-handler e)
    (cond ((> count 0)
           (displayln "Waiting for AutoCAD to be ready...")
           (sleep 1)
           (try-connection fn (- count 1)))
          (else
           (raise e))))
  (with-handlers ((exn:fail? try-connection-handler))
    (fn)))


(define autocad-com-trace? #f)

(define (trace-invoke . args)
  (cond (autocad-com-trace?
         (displayln args)
         (let ((e (apply com-invoke args)))
           (displayln (format "-> ~A" e))
           e))
        (else
         (apply com-invoke args))))


(define (autocad-invoke . args)
  (try-connection
   (λ () (apply trace-invoke args))))

(define (autocad-get-property . args)
  (try-connection
   (λ () (apply com-get-property args))))


(define autocad-coclass #f)
(define autocad-document #f)
(define autocad-coobject #f)


(define (load-autocad-com)
  (set! autocad-coclass
        (let ((coclass-name "AutoCAD Application"))
          (with-handlers ((exn?
                           (λ (e)
                             (displayln "Starting AutoCAD...")
                             (cci/coclass coclass-name))))
            (gao/coclass coclass-name))))
  (set! autocad-document
        (autocad-get-property autocad-coclass "ActiveDocument"))
  (set! autocad-coobject
        (autocad-get-property autocad-coclass "ActiveDocument" "ModelSpace"))
  ; edit: UNDO situation
  (delete-all-command))


; methods

(define (add-arc center radius start-angle end-angle)
  (autocad-invoke autocad-coobject "AddArc" center radius start-angle end-angle))

(define (add-circle center radius)
  (autocad-invoke autocad-coobject "AddCircle" center radius))

(define (add-ellipse center major-axis radius-ratio)
  (autocad-invoke autocad-coobject "AddEllipse" center major-axis radius-ratio))

(define (add-line start-point end-point)
  (autocad-invoke autocad-coobject "AddLine" start-point end-point))

(define (add-polyline points)
  (autocad-invoke autocad-coobject "AddPolyline" points))

(define (add-spline points start-tangent end-tangent)
  (autocad-invoke autocad-coobject "AddSpline" points start-tangent end-tangent))


(define (add-box origin length width height)
  (autocad-invoke autocad-coobject "AddBox" origin length width height))

(define (add-cone center base-radius height)
  (autocad-invoke autocad-coobject "AddCone" center base-radius height))

(define (add-cylinder center radius height)
  (autocad-invoke autocad-coobject "AddCylinder" center radius height))

(define (add-sphere center radius)
  (autocad-invoke autocad-coobject "AddSphere" center radius))

(define (add-extruded-solid profile height taper-angle)
  (autocad-invoke autocad-coobject "AddExtrudedSolid" profile height taper-angle))

(define (add-region shapes)
  (autocad-invoke autocad-coobject "AddRegion" shapes))

(define (boolean operation shape1 shape2)
  (with-handlers ((exn? (λ (e)
                          (displayln (get-object-name shape1))
                          (displayln (get-object-name shape2))
                          (raise e))))
    (autocad-invoke shape1 "Boolean" operation shape2)
    shape1))

(define (delete object)
  (autocad-invoke object "Delete"))

(define (end-undo-mark)
  (autocad-invoke autocad-document "EndUndoMark"))

(define (get-bounding-box object)
  (let ((min-point (vector 0.0 0.0 0.0))
        (max-point (vector 0.0 0.0 0.0)))
    (autocad-invoke object "GetBoundingBox" min-point #f)
    min-point))

(define (item i)
  (autocad-invoke autocad-coobject "Item" i))

(define (move shape point1 point2)
  (autocad-invoke shape "Move" point1 point2)
  shape)

(define (offset object distance)
  (autocad-invoke object "Offset" distance))

(define (rotate3d shape point1 point2 rotation-angle)
  (autocad-invoke
   shape
   "Rotate3D"
   point1
   point2
   rotation-angle)
  shape)

(define (start-undo-mark)
  (autocad-invoke autocad-document "StartUndoMark"))

(define (transform-by shape matrix)
  (autocad-invoke shape "TransformBy" matrix)
  shape)


; properties

(define (get-handle object)
  (autocad-get-property object "Handle"))

(define (get-modelspace-count)
  (autocad-get-property autocad-coobject "Count"))

(define (get-object-name object)
  (autocad-get-property object "ObjectName"))

(define (position object)
  (autocad-get-property object "Position"))


; arc properties

(define arc-name "AcDbArc")

(define (arc? object)
  (string=? (get-object-name object) arc-name))

(define (get-arc-center object)
  (com-get-property object "Center"))

(define (get-arc-radius object)
  (com-get-property object "Radius"))

(define (get-arc-start-angle object)
  (com-get-property object "StartAngle"))

(define (get-arc-end-angle object)
  (com-get-property object "EndAngle"))


; commands

(define vbCr
  (string-append
   (string #\return)
   (string #\newline)))

(define (send-command command)
  (autocad-invoke
   autocad-document
   "SendCommand"
   command))

(define (delete-all-command)
  (send-command (string-append "erase all" vbCr)))